home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 4 / BBS in a Box - Macintosh - Volume IV (January 1992) (BBS in a Box).iso / Files / Prog / T / TransSkel2p.cpt / TransSkel ƒ.np / Dialog ƒ / DialogSkel.p next >
Encoding:
Text File  |  1988-12-09  |  6.9 KB  |  331 lines  |  [TEXT/PJMM]
  1. { This program requires  TransSkel.p, Runtime.lib and Interface.lib in the same    }
  2. { project.    Also requires you to set the resource file to Dialog.proj.rsrc in the run options }
  3. { Puts up 2 dialog boxes, whose items affect the other dialog            }
  4. { ported to LS Pascal by Owen Hartnett, Ωhm Software Co.                        }
  5. { 7 January 1987    }
  6. {30 December 1987 - changes for version 2.00 }
  7. { Warning: Compile Time variable supportdialogs in TransSkel.p must be set to true! }
  8.  
  9. program DialogSkel;
  10.  
  11.     uses
  12. {$IFC UNDEFINED THINK_PASCAL}
  13.         Memtypes, Quickdraw, OSIntf, ToolIntf, PackIntf, 
  14. {$ENDC}
  15.         TransSkel;
  16.  
  17.  
  18.     const
  19.         mDlogRes = 1000;
  20.         aboutAlrtRes = 1001;    { About... alert resource number }
  21.  
  22.         showDlog1 = 1;            { File Menu item numbers            }
  23.         showDlog2 = 2;
  24.         quit = 4;
  25.  
  26.         undo = 1;                     { Edit menu item numbers }
  27.         cut = 3;
  28.         copy = 4;
  29.         paste = 5;
  30.         clear = 6;
  31.  
  32.         button1 = 1;                { dialog item numbers }
  33.         edit1 = 2;
  34.         static1 = 3;
  35.         radio1 = 4;
  36.         radio2 = 5;
  37.         radio3 = 6;
  38.         check1 = 7;
  39.         check2 = 8;
  40.         user1 = 9;
  41.  
  42.     type
  43.         EventPtr = ^EventRecord;
  44.  
  45.     var
  46.         mDlog1, mDlog2: DialogPtr;
  47.  
  48.         iconNum1, iconNum2: integer;
  49.  
  50.         dummy: Boolean;                                { may be used for memory management }
  51.  
  52.     procedure DrawIcon (dlog: DialogPtr; item: integer);
  53.         var
  54.             h, itemHandle: Handle;
  55.             itemType: integer;
  56.             itemRect: Rect;
  57.     begin
  58.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  59.         if dlog = mDlog1 then
  60.             h := GetIcon(iconNum1)
  61.         else
  62.             h := GetICon(iconNum2);
  63.         PlotIcon(itemRect, h);
  64.     end;
  65.  
  66.     function GetDctl (dlog: DialogPtr; item: integer): Boolean;
  67.  
  68.         var
  69.             itemHandle: Handle;
  70.             itemType: integer;
  71.             itemRect: Rect;
  72.  
  73.     begin
  74.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  75.         GetDCtl := Boolean(GetCtlValue(ControlHandle(itemhandle)));
  76.     end;
  77.  
  78.     procedure SetDCtl (dlog: DialogPtr; item: integer; value: Boolean);
  79.  
  80.         var
  81.             itemHandle: Handle;
  82.             itemType: integer;
  83.             itemRect: Rect;
  84.     begin
  85.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  86.         SetCtlValue(ControlHandle(itemHandle), integer(value));
  87.     end;
  88.  
  89.     procedure GetDtext (dlog: DialogPtr; item: integer; var str: Str255);
  90.  
  91.         var
  92.             itemHandle: Handle;
  93.             itemType: integer;
  94.             itemRect: Rect;
  95.  
  96.     begin
  97.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  98.         GetIText(itemHandle, str);
  99.     end;
  100.  
  101.     procedure SetDText (dlog: DialogPtr; item: integer; str: Str255);
  102.         var
  103.             itemHandle: Handle;
  104.             itemType: integer;
  105.             itemRect: Rect;
  106.     begin
  107.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  108.         SetIText(itemHandle, str);
  109.     end;
  110.  
  111.     procedure SetDProc (dlog: DialogPtr; item: integer; p: ProcPtr);
  112.         var
  113.             itemHandle: Handle;
  114.             itemType: integer;
  115.             itemRect: Rect;
  116.     begin
  117.         GetDItem(dlog, item, itemType, itemHandle, itemRect);
  118.         SetDITem(dlog, item, itemType, Handle(p), itemRect);
  119.     end;
  120.  
  121.     procedure SetDRadio (dlog: DialogPtr; item: integer);
  122.  
  123.         var
  124.             partner: DialogPtr;
  125.             itemHandle: Handle;
  126.             itemType: integer;
  127.             itemRect: Rect;
  128.     begin
  129.         partner := DialogPtr(GetWRefCon(dlog));
  130.         SetDCtl(dlog, radio1, item = radio1);
  131.         SetDCtl(dlog, radio2, item = radio2);
  132.         SetDCtl(dlog, radio3, item = radio3);
  133.         if partner = mDlog1 then
  134.             iconNum1 := item - radio1
  135.         else
  136.             iconNum2 := item - radio1;
  137.  
  138.         GetDItem(partner, user1, itemType, itemHandle, itemRect);
  139.         SetPort(partner);
  140.         InvalRect(itemRect);
  141.     end;
  142.  
  143.     procedure Event (item: integer; event: EventPtr);
  144.  
  145.         var
  146.             actor, partner: DialogPtr;
  147.             title: Str255;
  148.             value: Boolean;
  149.             mypeek: WindowPeek;
  150.             mychar: Boolean;
  151.  
  152.     begin
  153.         GetPort(actor);
  154.         partner := DialogPtr(GetWRefCon(actor));
  155.         case item of
  156.             button1: 
  157.                 begin
  158.                     GetDText(actor, edit1, title);
  159.                     SetWTitle(partner, title);
  160.                 end;
  161.             radio1: 
  162.                 SetDRadio(actor, radio1);
  163.             radio2: 
  164.                 SetDRadio(actor, radio2);
  165.             radio3: 
  166.                 SetDRadio(actor, radio3);
  167.             check1: 
  168.                 begin
  169.                     value := not (GetDCtl(actor, item));
  170.                     SetDCtl(actor, item, value);
  171.                     if value = false then
  172.                         HideWindow(partner)
  173.                     else
  174.                         ShowWindow(partner);
  175.                 end;
  176.             check2: 
  177.                 begin
  178.                     value := not (GetDCtl(actor, check2));
  179.                     SetDCtl(actor, check2, value);
  180.                     mypeek := WindowPeek(partner);
  181.                     if value then
  182.                         mychar := true
  183.                     else
  184.                         mychar := false;
  185.  
  186.                     mypeek^.goAwayFlag := mychar;
  187.                 end;
  188.             otherwise
  189.         end;
  190.     end;
  191.  
  192.     procedure Close;
  193.  
  194.         var
  195.             actor, partner: DialogPtr;
  196.  
  197.     begin
  198.         GetPort(actor);
  199.         partner := DialogPtr(GetWRefCon(actor));
  200.         HideWindow(actor);
  201.         SetDCtl(partner, check1, false);
  202.     end;
  203.  
  204.     procedure Clobber;
  205.  
  206.         var
  207.             theDialog: DialogPtr;
  208.  
  209.     begin
  210.         GetPort(theDialog);
  211.         DisposDialog(theDialog);
  212.     end;
  213.  
  214. {    File menu handler}
  215.  
  216.     procedure DoFileMenu (item: integer);
  217.  
  218.     begin
  219.         case item of
  220.             showDlog1: 
  221.                 begin
  222.                     SelectWindow(mDlog1);
  223.                     ShowWindow(mDlog1);
  224.                     SetDCtl(mDlog2, check1, true);
  225.                 end;
  226.             showDlog2: 
  227.                 begin
  228.                     SelectWindow(mDlog2);
  229.                     ShowWindow(mDlog2);
  230.                     SetDCtl(mDlog1, check1, true);
  231.                 end;
  232.             quit: 
  233.                 SkelWhoa;
  234.         end;
  235.     end;
  236.  
  237. {    Handle Edit menu items for text window}
  238.  
  239.     procedure DoEditMenu (item: integer);
  240.  
  241.         var
  242.             theDialog: DialogPtr;
  243.             mypeek: WindowPeek;
  244.             ignore: integer;
  245.  
  246.     begin
  247.         theDialog := DialogPtr(FrontWindow);
  248.         mypeek := WindowPeek(theDialog);
  249.         if mypeek^.windowKind = dialogKind then
  250.             case item of
  251.                 cut: 
  252.                     begin
  253.                         DlgCut(theDialog);
  254.                         ignore := ZeroScrap;
  255.                         ignore := TEToScrap;
  256.                     end;
  257.                 copy: 
  258.                     begin
  259.                         DlgCopy(theDialog);
  260.                         ignore := ZeroScrap;
  261.                         ignore := TEToScrap;
  262.                     end;
  263.                 paste: 
  264.                     begin
  265.                         ignore := TEFromScrap;
  266.                         DlgPaste(theDialog);
  267.                     end;
  268.                 clear: 
  269.                     DlgDelete(theDialog);
  270.             end;
  271.     end;
  272.  
  273. {    Handle selection of About… item from Apple menu}
  274.  
  275.     procedure DoAbout;
  276.  
  277.         var
  278.             ignore: integer;
  279.     begin
  280.         ignore := Alert(aboutAlrtRes, nil);
  281.     end;
  282.  
  283.     function DemoDialog (title: Str255; x, y: integer): DialogPtr;
  284.  
  285.         var
  286.             theDialog: DialogPtr;
  287.  
  288.     begin
  289.         theDialog := GetNewDialog(mDlogRes, nil, WindowPtr(-1));
  290.         MoveWindow(theDialog, x, y, false);
  291.         SetWTitle(theDialog, title);
  292.         dummy := SkelDialog(theDialog, @Event, @Close, @Clobber);
  293.         DemoDialog := theDialog;
  294.     end;
  295.  
  296.     var
  297.         m: MenuHandle;
  298.  
  299. begin
  300.     iconNum1 := 0;
  301.     iconNum2 := 0;
  302.     SkelInit(6, nil);
  303.     SkelApple('AboutDialogSkel...', @DoAbout);
  304.     m := NewMenu(1000, 'File');
  305.     AppendMenu(m, 'Show Dialog 1;Show Dialog 2;(-;Quit/Q');
  306.     dummy := SkelMenu(m, @DoFileMenu, nil, false);
  307.  
  308.     m := NewMenu(1001, 'Edit');
  309.     AppendMenu(m, '(Undo/Z;(-;Cut/X;Copy/C;Paste/V;Clear');
  310.     dummy := SkelMenu(m, @DoEditMenu, nil, true);
  311.  
  312.     mDlog1 := DemoDialog('Modeless Dialog 1', 50, 50);
  313.     mDlog2 := DemoDialog('Modeless Dialog 2', 150, 200);
  314.     SetWRefCon(WindowPtr(mDlog1), longint(mDlog2));
  315.     SetWRefCon(WindowPtr(mDlog2), longint(mDlog1));
  316.     SetDText(mDlog1, edit1, 'Modeless Dialog 2');
  317.     SetDText(mDlog2, edit1, 'Modeless Dialog 1');
  318.     SetDProc(mDlog1, user1, @DrawIcon);
  319.     SetDProc(mDlog2, user1, @DrawIcon);
  320.     SetDCtl(mDlog1, radio1, true);
  321.     SetDCtl(mDlog2, radio1, true);
  322.     SetDCtl(mDlog1, check1, true);
  323.     SetDCtl(mDlog2, check1, true);
  324.     SetDCtl(mDlog1, check2, true);
  325.     SetDCtl(mDlog2, check2, true);
  326.     ShowWindow(mDlog1);
  327.     ShowWindow(mDlog2);
  328.  
  329.     SkelMain;
  330.     SkelClobber;
  331. end.